home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / colwheel / colwheel.ml next >
Encoding:
Text File  |  1995-06-01  |  2.1 KB  |  81 lines  |  [TEXT/MPS ]
  1. #open "graphics";;
  2.  
  3. (* Conversion from HSB (hue-saturation-brightness) to RGB.
  4.    H, S and B are in the range 0..255. *)
  5.  
  6. let max = 255;;
  7.  
  8. let nround x y = (2*x+y)/(2*y);;
  9.  
  10. let rgb_of_hsb H S V =
  11.   let H = H*6 in
  12.   let I = H/max*max in
  13.   let F = H-I in
  14.   let M = V*(max-S)/max and N = V*(max-S*F/max)/max
  15.   and K = V*(max-S*(max-F)/max)/max in
  16.   graphics__rgb
  17.     (nround (max*(
  18.       match I/max with
  19.         0 | 6 -> V | 1 -> N | 2 -> M | 3 -> M | 4 -> K | 5 -> V
  20.     )) max)
  21.     (nround (max*(
  22.       match I/max with
  23.         0 | 6 -> K | 1 -> V | 2 -> V | 3 -> N | 4 -> M | 5 -> M
  24.     )) max)
  25.     (nround (max*(
  26.       match I/max with
  27.         0 | 6 -> M | 1 -> M | 2 -> K | 3 -> V | 4 -> V | 5 -> N
  28.     )) max)
  29. ;;
  30.  
  31. let pi180 = 3.141592654 /. 180.0;;
  32.  
  33. let wheel s v r =
  34.   for theta = 0 to 23 do
  35.     set_color (rgb_of_hsb (theta * max / 24) s v);
  36.     fill_arc (size_x()/2) (size_y()/2) r r (theta * 15) (theta * 15 + 15)
  37.   done
  38. ;;
  39.  
  40. let wheels v =
  41.   for r = 8 downto 1 do
  42.     wheel (r * max / 8) v (r * (size_y()/20))
  43.   done
  44. ;;
  45.  
  46. let main() =
  47.   open_graph "";
  48.   let (msg_w, msg_h) = text_size "Press 'q' to quit    R=999 G=999 B=999" in
  49.   try
  50.     wheels max;
  51.     set_color foreground;
  52.     moveto 0 0; draw_string "Press 'q' to quit";
  53.     while true do
  54.       let e = wait_next_event [Button_down; Key_pressed] in
  55.         if e.keypressed then begin
  56.           match e.key with
  57.             `0` .. `9` ->
  58.               clear_graph();
  59.               wheels ((int_of_char e.key - 48) * max / 9)
  60.           | `q` | `Q` ->
  61.               raise Exit
  62.           | _ ->
  63.               ()
  64.         end else
  65.         if e.button then begin
  66.           let c = point_color e.mouse_x e.mouse_y in
  67.           let r = c lsr 16 and g = (c lsr 8) land 255 and b = c land 255 in
  68.             set_color background;
  69.             fill_rect 0 0 msg_w msg_h;
  70.             set_color foreground;
  71.             moveto 0 0;
  72.             draw_string ("Press 'q' to quit    R=" ^ string_of_int r ^
  73.                          " G=" ^ string_of_int g ^ " B=" ^ string_of_int b)
  74.         end
  75.     done
  76.   with Exit ->
  77.     close_graph()
  78. ;;
  79.  
  80. if sys__interactive then () else begin main(); exit 0 end;;
  81.